home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / pc / LOGIC Apple II 5.25" Library - DOS Part 2 / DOS047.dsk / DISK SORT-VER 3.3.bas < prev    next >
BASIC Source File  |  2012-02-16  |  9KB  |  194 lines
  1. 100  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>*************************
  2. 110  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>*                       *
  3. 120  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>* DISK SORT VERSION 2.0 *
  4. 130  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>*      BY TED COHN      *
  5. 140  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>*   (C) FEBRUARY 1981   *
  6. 150  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>*  ALL RIGHTS RESERVED  *
  7. 160  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>*    S.F. APPLE CORE    *
  8. 170  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>* ..................... *
  9. 180  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>*                       *
  10. 190  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>* MS: MAX SECTORS/TRACK *
  11. 200  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>*     (15 FOR DOS 3.3)  *
  12. 210  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>* MF: MAX FILES/CATALOG *
  13. 220  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>*     (NORMALLY 80)     *
  14. 230  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>* R:  EXTERNAL MACHINE  *
  15. 240  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>*     LANGUAGE ROUTINE  *
  16. 250  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>* B:  DATA BUFFER ADDR. *
  17. 260  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>*                       *
  18. 270  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>*************************
  19. 280  LOMEM: ( PEEK(176) +2) *256
  20. 290 MS = 15
  21. 300 MF = 80
  22. 310 RD = 1
  23. 320 WR = 2
  24. 330 D$ =  CHR$(4)
  25. 340 M$ =  CHR$(13)
  26. 350 E$ =  CHR$(27)
  27. 360 Q$ =  CHR$(34)
  28. 370 R =  PEEK(175) + PEEK(176) *256 -100
  29. 380 B = ( PEEK(176) +1) *256
  30. 390  POKE 7, INT(B/256)
  31. 400  DIM F$(MF),P%(MF),T%(MF),S%(MF),L%(MF),E%(MF),Q%(MF)
  32. 410  HOME : TEXT : POKE  -16298,0: GOTO 470
  33. 420  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>   <CTRL-J><CTRL-J>CENTERING ROUTINE<CTRL-J><CTRL-J> 
  34. 430  CALL  -958: HTAB 20 - LEN(C$)/2
  35. 440  PRINT C$: PRINT 
  36. 450  RETURN 
  37. 460  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>   <CTRL-J><CTRL-J>TITLE PAGE INFORMATION<CTRL-J><CTRL-J>
  38. 470  VTAB 5:C$ = "DISK SORT": GOSUB 420
  39. 480 C$ = "BY TED COHN": GOSUB 420
  40. 490 C$ = "COPYRIGHT (C) 1981": GOSUB 420
  41. 500 C$ = "ALL RIGHTS RESERVED.": GOSUB 420
  42. 510 C$ = "SAN FRANCISCO APPLE CORE": GOSUB 420
  43. 520 C$ = "FOR DOS 3.2": IF MS = 15  THEN C$ =  LEFT$(C$,10) +"3"
  44. 525  GOSUB 420: GOSUB 1950
  45. 530  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>   <CTRL-J><CTRL-J>ASK FOR INSTRUCTIONS<CTRL-J><CTRL-J>
  46. 540  HOME : VTAB 10: PRINT  TAB( 10)"INSTRUCTIONS? (Y/N) ";
  47. 550  GET C$: IF C$ = "Y"  THEN 930
  48. 560  IF C$ = E$  THEN 2000
  49. 570  IF C$ < >"N"  THEN 550
  50. 580  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>   <CTRL-J><CTRL-J>ASK FOR TYPE OF SORT<CTRL-J><CTRL-J>
  51. 590  HOME : VTAB 6
  52. 600 C$ = "CHOOSE ONE OF THE FOLLOWING SORTS:": GOSUB 420: PRINT 
  53. 610 C$ = "(1)  SORT BY FILE NAMES  ": GOSUB 420
  54. 620 C$ = "(2)  SORT BY FILE TYPES  ": GOSUB 420
  55. 630 C$ = "(3)  SORT BY FILE SECTORS": GOSUB 420
  56. 640  PRINT : PRINT "  ENTER THE NUMBER OF DESIRED SORT?";
  57. 650  GET C$:ST =  VAL(C$)
  58. 660  IF C$ = E$  THEN 2000
  59. 670  IF ST <1  OR ST >3  THEN 650
  60. 680  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>   <CTRL-J><CTRL-J>MAIN PROGRAM SEGMENT<CTRL-J><CTRL-J>
  61. 690  GOSUB 730: GOSUB 1300: GOSUB 1410
  62. 700  ON ST GOTO 1720,1520,1620
  63. 710  END 
  64. 720  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>   <CTRL-J><CTRL-J>PLACE DISK IN DRIVE<CTRL-J><CTRL-J>
  65. 730  CALL R +65
  66. 740 SL =  PEEK(3):DR =  PEEK(4)
  67. 750  HOME : VTAB 6
  68. 760  PRINT "DISK SPECIFICATIONS": PRINT : PRINT 
  69. 770  PRINT "    SLOT  : "SL;: HTAB 13
  70. 780  GET C$:C =  VAL(C$): IF C$ = E$  THEN 2000
  71. 790  IF C$ = M$  THEN  PRINT : GOTO 830
  72. 800  IF C <1  OR C >7  THEN 780
  73. 810 SL = C
  74. 820  PRINT SL
  75. 830  PRINT : PRINT "    DRIVE : "DR;: HTAB 13
  76. 840  GET C$:C =  VAL(C$): IF C$ = E$  THEN 2000
  77. 850  IF C$ = M$  THEN  PRINT : GOTO 890
  78. 860  IF C <1  OR C >2  THEN 840
  79. 870 DR = C
  80. 880  PRINT DR
  81. 890  POKE 3,SL: POKE 4,DR
  82. 900  PRINT : PRINT : PRINT "INSERT DISK AND PRESS RETURN";: GET C$: IF C$ = E$  THEN 2000
  83. 910  HOME : VTAB 7:C$ = "DISK SORT VERSION 2.0": INVERSE : GOSUB 420: NORMAL : RETURN 
  84. 920  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>   <CTRL-J><CTRL-J>PRINT INSTRUCTIONS<CTRL-J><CTRL-J>
  85. 930  HOME 
  86. 940  PRINT "---------------------------------------": INVERSE : PRINT "              DISK SORT                ": NORMAL : PRINT "---------------------------------------": PRINT 
  87. 950  PRINT "DISK SORT WILL REARRANGE THE FILE NAMES"
  88. 960  PRINT "OF A  DISK  CATALOG  INTO  ALPHABETICAL"
  89. 970  PRINT "ORDER.  YOU HAVE THE OPTION OF  SORTING"
  90. 980  PRINT "A FILE BY  ITS TYPE.  INTEGER FILES ARE"
  91. 990  PRINT "PLACED ON THE CATALOG FIRST,  APPLESOFT"
  92. 1000  PRINT "FILES SECOND,  BINARY FILES THIRD,  AND"
  93. 1010  PRINT "TEXT FILES LAST. YOU  MAY  ALSO  SORT A"
  94. 1020  PRINT "FILE BY ITS SECTOR LENGTH.": PRINT 
  95. 1030  PRINT "AFTER  CHOOSING  THE TYPE  OF  SORT YOU"
  96. 1040  PRINT "WISH,  ENTER THE DRIVE  SPECIFICATIONS,"
  97. 1050  PRINT "THEN  HIT  RETURN  TO  BEGIN THE  SORT."
  98. 1060  PRINT "THE  RED  LIGHT  ON THE DISK DRIVE WILL"
  99. 1070  PRINT "BLINK FOR A WHILE --- IT IS READING THE"
  100. 1080  PRINT "DISK --- ";: FLASH : PRINT "DO NOT REMOVE UNTIL THROUGH!!!": NORMAL 
  101. 1090  PRINT "DISK SORT WAS  DEVELOPED SO USERS COULD"
  102. 1100  PRINT "SPOT PROGRAMS ON CATALOGS MORE QUICKLY."
  103. 1110  GOSUB 1950: POKE 34,4: HOME : POKE 34,0: VTAB 5
  104. 1120  PRINT "THIS   PROGRAM   WILL  WORK  ON  EITHER"
  105. 1130  PRINT "DOS 3.2, DOS 3.2.1, OR DOS 3.3. FOR USE"
  106. 1140  PRINT "WITH DOS 3.3, MAKE SURE THAT YOU CHANGE"
  107. 1150  PRINT "THE VARIABLE 'MS'  IN LINE  290 FROM 12"
  108. 1160  PRINT "TO 15, THEN RESAVE DISK SORT.": PRINT 
  109. 1170  PRINT "DISK SORT IS  PUBLIC DOMAIN, AND MAY BE"
  110. 1180  PRINT "COPIED AND DISTRIBUTED  WITHOUT CHARGE."
  111. 1190  PRINT "HOWEVER,  ALL RIGHTS ARE RESERVED,  AND"
  112. 1200  PRINT "DISK SORT MAY NOT BE SOLD.": PRINT 
  113. 1210  PRINT "WHEN COPYING, DON'T WORRY ABOUT COPYING"
  114. 1220  PRINT "ANOTHER MACHINE LANGUAGE FILE  ( AS  IN"
  115. 1230  PRINT "THE OLD VERSION). THE  MACHINE LANGUAGE"
  116. 1240  PRINT "ROUTINES ARE TACKED TO THE  END OF THIS"
  117. 1250  PRINT "PROGRAM, AND DISK SORT MAY BE COPIED BY"
  118. 1260  PRINT "SIMPLY LOADING AND SAVING THROUGH BASIC.";
  119. 1270  GOSUB 1950
  120. 1280  GOTO 590
  121. 1290  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>   <CTRL-J><CTRL-J>READ DIRECTORY              IMAGE FROM DISK<CTRL-J><CTRL-J>
  122. 1300 N =  -1
  123. 1310  VTAB 10:C$ = "READING DIRECTORY": GOSUB 420
  124. 1320  FOR S = MS TO 1  STEP  -1
  125. 1330  VTAB 12: HTAB 10: PRINT "TRACK/SECTOR: 17,"S" "
  126. 1340  POKE 0,17: POKE 1,S: POKE 2,RD: CALL R
  127. 1350  FOR I = B +14 TO B +255  STEP 35: IF  PEEK(I) = 0  THEN 1400
  128. 1355  IF  PEEK(I -3) = 255  THEN 1390
  129. 1360 N = N +1
  130. 1370 P%(N) =  PEEK(I -1):T%(N) =  PEEK(I -3):S%(N) =  PEEK(I -2):L%(N) =  PEEK(I +30):E%(N) =  PEEK(I +31):F$(N) = ""
  131. 1380  FOR J = 0 TO 29:F$(N) = F$(N) + CHR$( PEEK(I +J)): NEXT 
  132. 1390  NEXT : NEXT 
  133. 1400  FOR I = 0 TO N:Q%(I) = I: NEXT : RETURN 
  134. 1410  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>   <CTRL-J><CTRL-J>SIMPLE ALPABETIC            BUBBLE SORT ROUTINE         (SORRY IT'S SLOW!)<CTRL-J><CTRL-J>
  135. 1420  VTAB 10:C$ = "SORTING DIRECTORY": GOSUB 420
  136. 1430 F = 0
  137. 1440  FOR I = 0 TO N -1
  138. 1450 X = Q%(I):Y = Q%(I +1)
  139. 1460  IF F$(X) < = F$(Y)  THEN 1490
  140. 1470 Q%(I) = Y:Q%(I +1) = X
  141. 1480 F = 1
  142. 1490  NEXT 
  143. 1500  IF F  THEN 1430
  144. 1510  RETURN 
  145. 1520  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>   <CTRL-J><CTRL-J>TYPE SORT<CTRL-J>                     
  146. 1530 F = 0
  147. 1540  FOR T = 0 TO 4: IF T = 3  THEN 1590
  148. 1550  FOR I = 0 TO N
  149. 1560 X = P%(I) -128: IF X <0  THEN X = X +128
  150. 1570  IF X = T  THEN Q%(F) = I:F = F +1
  151. 1580  NEXT 
  152. 1590  NEXT 
  153. 1600  GOTO 1720
  154. 1610  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>   <CTRL-J><CTRL-J>SECTOR SORT<CTRL-J><CTRL-J>
  155. 1620 F = 0
  156. 1630  FOR I = 0 TO N -1
  157. 1640  IF L%(Q%(I)) < = L%(Q%(I +1))  THEN 1670
  158. 1650 X = Q%(I):Q%(I) = Q%(I +1):Q%(I +1) = X
  159. 1660 F = 1
  160. 1670  NEXT 
  161. 1680  IF F  THEN 1620
  162. 1690  GOTO 1720
  163. 1700  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>   <CTRL-J><CTRL-J>CLEAR DATA BUFFER<CTRL-J><CTRL-J>
  164. 1710  FOR Z = B TO B +255: POKE Z,0: NEXT : RETURN 
  165. 1720  REM <CTRL-H><CTRL-H><CTRL-H><CTRL-H>   <CTRL-J><CTRL-J>WRITE NEW DIRECTORY         IMAGE BACK TO DISK<CTRL-J><CTRL-J>
  166. 1730 C$ = "WRITING DIRECTORY": VTAB 10: GOSUB 420
  167. 1740 I = 0
  168. 1750  FOR S = MS TO 1  STEP  -1
  169. 1760  VTAB 12: HTAB 10: PRINT "TRACK/SECTOR: 17,"S" "
  170. 1770  GOSUB 1710
  171. 1780  POKE B +1,17: POKE B +2,S -1
  172. 1790  FOR J = B +11 TO B +255  STEP 35
  173. 1800 X = Q%(I)
  174. 1810  POKE J,T%(X): POKE J +1,S%(X)
  175. 1820  POKE J +2,P%(X): POKE J +33,L%(X)
  176. 1830  POKE J +34,E%(X)
  177. 1840  FOR K = 1 TO 30: POKE J +K +2, ASC( MID$ (F$(X),K,1)): NEXT 
  178. 1850  POKE 0,17: POKE 1,S: POKE 2,WR: CALL R
  179. 1860 I = I +1: IF I >N  THEN S = S -1: GOTO 1890
  180. 1870  NEXT 
  181. 1880  NEXT 
  182. 1890  IF S = 0  THEN 1930
  183. 1895  GOSUB 1710:X = S
  184. 1900  FOR S = X TO 1  STEP  -1
  185. 1910  POKE 0,17: POKE 1,S: POKE 2,WR: POKE B +1,17: POKE B +2,S -1: CALL R
  186. 1920  NEXT 
  187. 1930  HOME : PRINT D$"CATALOGS"SL",D"DR
  188. 1940  END 
  189. 1950  VTAB 23: HTAB 4
  190. 1960  INVERSE : PRINT "ESC";: NORMAL : PRINT " TO QUIT, ";: INVERSE : PRINT "SPACEBAR";: NORMAL : PRINT " TO CONTINUE";
  191. 1970  GET C$
  192. 1980  IF C$ = " "  THEN  RETURN 
  193. 1990  IF C$ < >E$  THEN 1970
  194. 2000  HOME : END